{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, FunctionalDependencies #-}
module Data.EitherLike where



class EitherLike l r v | v -> l, v -> r where
        left :: l -> v
        right :: r -> v
        isLeft :: v -> Bool
        isRight :: v -> Bool
        unLeft :: v -> Maybe l
        unRight :: v -> Maybe r
        toEither :: v -> Either l r
        fromEither :: Either l r -> v
        toEitherLike :: (EitherLike l r ll) => v -> ll
        fromEitherLike :: (EitherLike l r ll) => ll -> v
        mapEitherLikes :: (EitherLike l1 r1 v1) => (l-> l1) -> (r-> r1) -> v -> v1
        left x = fromEither $ Left x
        right y = fromEither $ Right y
        isLeft x = case (toEither x) of (Left _) -> True
                                        (Right _) -> False
        isRight x = not $ isLeft x
        unLeft x = case (toEither x) of (Left a) -> Just a
                                        (Right _) -> Nothing
        unRight y = case (toEither y) of (Left _) -> Nothing
                                         (Right a) -> Just a
        fromEither (Left x) = left x
        fromEither (Right y) = right y
        toEither v = case (unLeft v,unRight v) of
                          (Just _,Just _) ->
                                error "EitherLike instance non-consistent: unLeft and unRight must be exclusive"
                          (Just x,_) -> Left x
                          (_,Just y) -> Right y
                          _ -> -- (Nothing,Nothing)
                                error "EitherLike instance non-consistent: unLeft and unRight must be exclusive"
        toEitherLike v = fromEither $ toEither v
        fromEitherLike v = fromEither $ toEither v
        mapEitherLikes fl fr val = case (toEither val) of
                                        (Left x)  -> left  $ fl x
                                        (Right y) -> right $ fr y


instance EitherLike l r (Either l r) where
        left = Left
        right = Right
        isLeft (Left _) = True
        isLeft (Right _) = False
        isRight (Left _) = False
        isRight (Right _) = True
        unLeft (Left x) = Just x
        unLeft (Right _) = Nothing
        unRight (Right x) = Just x
        unRight (Left _) = Nothing
        toEither = id
        fromEither = id

data Tst = One Int | Two String deriving Show
instance EitherLike Int String Tst where
        toEither (One x) = Left x
        toEither (Two y) = Right y
        fromEither (Left x) = One x
        fromEither (Right y) = Two y

instance EitherLike () a (Maybe a) where
        left _ = Nothing
        right = Just
        toEither Nothing = Left ()
        toEither (Just x) = Right x

